home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / comm2 / mmstrdsc.lha / MM / Rexx / MM_SetAreaDesc.rexx.cmp < prev    next >
Text File  |  1996-04-28  |  9KB  |  17 lines

  1. /*
  2.  
  3.                   $VER: MM_SetAreaDesc.rexx 0.25/c  (28.04.96)
  4.  
  5.                            (C) 1995/96 Robert Hofmann
  6.  
  7. */
  8. parse arg opts;options cache;options failat 99;options results;signal on break_c;signal on break_d;signal on break_e;signal on break_f;signal on halt;signal on ioerr;signal on syntax;address 'MAILMANAGER';Main:;call Init;call Parse_Args(opts);call Header;call Set_Desc;call Quit(0, 'All done.');exit;break_c:; break_d:; break_e:; break_f:; halt:;signal off break_c;signal off break_d;signal off break_e;signal off break_f;signal off halt;return_code = 5;error_line = 0;error_msg = 'Execution halted!!!';rc = 0;signal Exit;Exit:;select;when return_code>=40 then error = 'INTERNAL-ERROR:';when return_code>=30 then error = 'IO-ERROR:';when return_code>=20 then error = 'ERROR:';when return_code>=10 then error = 'WARNING:';when return_code>=5 then error = 'INFO:';otherwise error = '';end;call Log();call Log('***' strip(error error_msg) '***', '+');call Log(,'\');call setclip('MM_LogPre', system.mm.logpre);exit return_code;Expand_Path: procedure;parse arg path
  9. if pos(':', path)+pos('/', path)=0 then path = path(pragma('d')) || path;return path;Get_Arg: procedure Expose args system.;arg keyword, mode, old;uargs = upper(args);p = find(uargs, keyword);if p=0 then do;p = pos(' 'keyword'=', ' 'uargs);if p>0 then args = overlay(' ', args, p+length(keyword));p = find(upper(args), keyword);end;system.cmdopt.keyword = p>0;select;when mode=0 then if p>0 then do;ret = 1;args = delword(args, p, 1);end;else ret = old;when mode=1 then if p>0 then do;left = subword(args, 1, p-1);rest = subword(args, p+1);if left(rest, 1)='"' then parse var rest . '"' ret '"' rest;else parse var rest ret rest;args = strip(left strip(rest));end;else ret = old;when mode=2 then do;if left(args, 1)='"' then parse var args . '"' ret '"' args;else parse var args ret args;if strip(ret)='' then ret = old;end;otherwise exit 99;end;args = strip(args);ret = strip(ret, 'b', '" ');return ret;Get_Version: procedure;parse arg mode;parse value sourceline(3-mode) with . . ver .;parse var ver tst 'ß' .
  10. if ~datatype(strip(tst, 'b', '/ce '), 'N') then if ~mode then ver = Get_Version(1);else exit 99;return ver;Header:;call Log(,'/');call Log('***' system.prg.id '***', '+');call Log('  'system.prg.cr);call Log();return;Init:;system. = 0;MM_GetTaskPri 'system.taskpri';call pragma('p', system.taskpri);system.prg.name = 'MM_SetAreaDesc';system.prg.ver = Get_Version(0);system.prg.id = system.prg.name 'v'system.prg.ver;system.prg.cr = '(C) 1995/96 Robert Hofmann';system.mm.logpre = getclip('MM_LogPre');system.prg.logpre = system.mm.logpre'|';system.status = '';call setclip('MM_LogPre', system.prg.logpre);system.cmdopts = 'OLDCFG/A,NEWCFG/A,DESCFILE/A,FORCE/S,QUIET/S,INSERT/S,REPLACE/S';call Include_Lib('rexxsupport');return;Include_Lib: procedure;parse arg lib, prio;if right(upper(lib), 8)~='.LIBRARY' then lib=lib'.library';if prio='' then prio=0;if ~show('l', lib) then if ~addlib(lib, prio, -30, 0) then do;say '*** ERROR: Could not open' lib'!!! ***';exit 10;end;return;IOerr:;signal off ioerr;return_code = 20
  11. error_line = sigl;error_msg = 'IO-error' rc 'at line' sigl '['errortext(rc)']');rc = 0;signal Exit;Log: procedure Expose system.;parse arg text, pre;tmp = word('PRG MM', (pre~='')+1);text = system.tmp.logpre || pre' 'text;MM_WriteLog 'text' '2';return;Path: procedure;parse arg path;tmp = right(path, 1);if tmp~='/' & tmp~=':' then path = path'/';return path;Parse_Args: procedure Expose system.;parse arg args;tpl = system.cmdopts',?/S';args = translate(args, ' ', '9'x);pk = pos('/K', tpl);ps = pos('/S', tpl);select;when pk=0 & ps=0 then p = 0;when pk=0 & ps>0 then p = ps;when ps=0 & pk>0 then p = pk;otherwise p = min(pk, ps);end;p = lastpos(',', left(tpl, p));tpl = substr(tpl',', p+1) || left(tpl, max(p-1, 0));do while tpl~='';parse var tpl template ',' tpl;parse var template keyword '/' .;bool = pos('/S', template)>0;key = pos('/K', template)>0;must = pos('/A', template)>0;num = pos('/N', template)>0;select;when must then system.arg.keyword = '0'x;when bool then system.arg.keyword = 0
  12. when num then system.arg.keyword = 0;otherwise system.arg.keyword = '';end;if bool | key then mode = ~bool;else mode = 2;system.arg.keyword = Get_Arg(keyword, mode, system.arg.keyword);if keyword='?' & system.arg.keyword=1 then leave;if must & system.arg.keyword='0'x then do;tmp = template 'missing!!!';say;say ' ***' tmp '***';signal Usage;end;if num & ~datatype(system.arg.keyword, 'N') then if ~must & system.arg.keyword='' then system.arg.keyword = 0;else;do;tmp = 'Numeric value expected for' template', but is "'system.arg.keyword'"!!!';say;say ' ***' tmp '***';signal Usage;end;end;tmp = '?'; if system.arg.tmp then signal Usage;if args~='' then call Quit(10, 'Unknown option(s):' args);system.arg.descfile = Expand_Path(system.arg.descfile);system.arg.newcfg = Expand_Path(system.arg.newcfg);system.arg.oldcfg = Expand_Path(system.arg.oldcfg);if ~exists(system.arg.oldcfg) then call Quit(30, system.arg.oldcfg 'does not exist!');if ~system.arg.force then
  13. if exists(system.arg.newcfg) then call Quit(31, system.arg.newcfg 'does already exist!');if ~exists(system.arg.descfile) then call Quit(32, system.arg.descfile 'does not exist!');return;Quit:;parse arg return_code, error_msg;error_line = 0;rc = 0;signal Exit;Replace: procedure;parse arg string, new, old;do while index(string, old) ~= 0;interpret "parse var string l '"old"' r";string = l || new || r;end;return string;Request_Choice: procedure Expose system.;parse arg text, buttons, ret_vals;title = system.prg.name'-Requester';text = translate(Replace(text, '0A'x, '\n'), '1b'x, '\');if length(text)<40 then text = center(text, 40);MM_Requester title 'text' 'buttons';if rc=0 then rc=words(ret_vals);return compress(word(ret_vals, rc), '_');Set_Desc: procedure Expose system.;if ~system.arg.quiet then Show;call Log(' Reading' system.arg.oldcfg'...');MM_ReadStem system.arg.oldcfg 'cfg';if RC~=0 then call Quit(34, 'Unable to read' system.arg.oldcfg);call Log(' Reading' system.arg.descfile'...')
  14. if ~open(in, system.arg.descfile, r) then call Quit(34, 'Unable to open' system.arg.descfile);desc. = '';do until eof(in);parse value translate(readln(in), ' ', '9'x) with area description;area = upper(strip(area));desc.area = strip(description, 'b', 'd'x'" ');end;call close(in);call Log(' Analysing...');do n=0 to cfg.count-1;parse value strip(translate(cfg.n, ' ', '9'x)) with key .;if key='' then iterate;typ = find('#ECHOAREA #FECHOAREA #TICKAREA', key);select;when typ=0 then iterate n;when typ=1 then parse var cfg.n . '"' . '"' area.name .;when typ=2 then parse var cfg.n . '"' . '"' area.name .;when typ=3 then parse var cfg.n . area.name .;otherwise exit 999;end;if typ~=3 then do;offs = 4;MM_GetAreaInfo area.name 'area.data';end;else;do;offs = 1;MM_GetTickAreaInfo area.name 'area.data';end;if RC~=0 then iterate;call Log('  Processing area' area.name);old_desc = area.data.desc;u_area = upper(area.name);new_desc = desc.u_area;if old_desc=new_desc | new_desc='' then iterate
  15. if system.arg.insert & old_desc~='' then iterate;add = 'a'x;line = -1;do m=n+offs while strip(cfg.m)~='';parse var cfg.m key value;if strip(key)~='Desc' then iterate;add = '';line = m;leave;end;if line=-1 then line = m;if system.arg.quiet then set = 1;else;do;txt = '\nArea    :' area.name'\nOld desc:' old_desc'\nNew Desc:' new_desc'\n';ret = Request_Choice(txt, ' S_KIP  | _QUIT | _ALL |*  _SET  ', '0 3 2 1');select;when ret=0 then set = 0;when ret=1 then set = 1;when ret=2 then do;system.all = 1;system.arg.quiet = 1;set = 1;end;when ret=3 then call Quit(5, 'Aborted by user.');otherwise exit 999;end;end;if set then do;call Log('   ->' new_desc);cfg.line = 'Desc      "'new_desc'"'add;end;n = line;end;call Log(' Writing' system.arg.newcfg'...');MM_WriteStem system.arg.newcfg 'cfg';if system.all then system.arg.quiet = 0;if system.arg.replace then do;rep = 1;if ~system.arg.quiet then rep = Request_Choice('\c\nShall I replace the',
  16. 'configuration-file\n\n'system.arg.oldcfg'\n\nwith\n\n'system.arg.newcfg'\n\n???', ' _NO  |* _YES ', '0 1');if ~rep then break;call Log(' Replacing' system.arg.oldcfg 'with' system.arg.newcfg'...');MM_MoveFile system.arg.oldcfg system.arg.oldcfg;MM_MoveFile system.arg.newcfg system.arg.oldcfg;call Log(' Reloading config...');MM_LoadCfg;end;if ~system.arg.quiet then call Request_Choice('   All done.   ', '* _Ok ', '0');return;Syntax:;signal off syntax;return_code = 40;error_line = sigl;error_msg = 'Syntax-error' rc 'at line' sigl '['errortext(rc)']';rc = 0;signal Exit;Usage:;rx. = '';rx.0.0 = '[rx] ';rx.0.1 = '[.rexx]';m = pos('/e', system.prg.ver)>0;tmp = rx.m.0 || system.prg.name || rx.m.1;say;say 'Usage:' tmp system.cmdopts;say;call Quit(0, 'Usage requested.')
  17.